8bitfiles.net/archives/archives.tar/archives/compuserve-file-archive/05 Programming/XMODV6.TXT

Text File | 2019-04-13 | 15KB | 850 lines

*
* XMODEM PROTOCOL VERSION 6.0
*
* COMMODORE 64
*
* THIS VERSION USES FILENAME
* SUPPLIED BY CALLING PROGRAM
* WITH CONSTRUCT:
*
*     A$="FILENAME"+CHR$(13)
*     SYS 49152,A
*
*     Where A =  0   Ignore carrier detect
*           A = 16   Check for carrier detect
*
* NOTE: Setting A$ *MUST* be just before SYS49152
*       with no intervening string operations!
*
* COPYRIGHT (C) 1986 BY
* MICROTECHNIC SOLUTIONS, INC.
* ALL RIGHTS RESERVED
*
* THIS VERSION RELEASED TO PUBLIC DOMAIN
*
 TR ON ;truncation on (MERLIN)
 ORG $C000
*
CHKIN = $FFC6
CHKOUT = $FFC9
CHROUT = $FFD2
CLOSE = $FFC3
CLRCHN = $FFCC
GETIN = $FFE4
OPEN = $FFC0
READSS = $FFB7
STOP = $FFE1
SETLFS = $FFBA
SETNAM = $FFBD
SOH = 1
ACK = 6
NAK = 21
EOT = 4
CAN = 24
VARPNT = $47
JIFFY = $A1
MOVE = $C3
RIDBE = $029B
RIDBS = $029C
ENABLE = $02A1
XMOBLK = $C700
BLOCK = $C800
BLN = $C800
BLO = $C801
BLCK1 = $C802
BLDATA = $C803
BLCH = $C883
DPORTB = $DD01
 JMP XMODEM
DRVDEV DFB 8
RCVCHR DFB 0
RSTAT DFB 0
CARRIER DFB 0
TEMPX DFB 0
FXMO DFB 0
XMOSZ DFB 128
LSTBLK DFB 0
PADCHR DFB 0
ERR DFB 0
BLKNUM DFB 0
CHRCNT DFB 0
CKSUM DFB 0
CISFMT DFB 4,0,67,67,51
EBUFX DFB 0
TRON DFB 128
TBCOUNT DA $0000
DSKDIR DFB 32
TMP2X DFB 0
FBUF DS 80
BUF DS 80
PLY DA $1021
CRCDATA DFB 0
XMODE DFB 0
CTRYS DFB 3
XBLSZ DFB 132
CRC DA 0
XMODEM AND #16 ;carrier request 16 or 0
 STA CARRIER ;save carrier request
 LDY #1 ;get the pointer to
 LDA (VARPNT),Y ;the last string variable
 STA MOVE ;referenced by the
 INY  ;calling Basic program
 LDA (VARPNT),Y
 STA MOVE+1
 CLC
 LDA MOVE
 ADC #1
 STA MOVE
 LDA MOVE+1
 ADC #0
 STA MOVE+1
 LDY #0
 LDX #0
]JLOOP LDA (MOVE),Y ;move the filename into
 CMP #13 ;filename buffer
 BEQ XMD04
 STA FBUF,X
 INX
 INY
 BNE ]JLOOP
XMD04 STY TEMPX
 LDX TEMPX
 DEX
 LDA #0 ;default is translation off
 STA TRON
 LDA FBUF,X
 STA TMP2X
 CMP #'t' ;check if last entry in
 BNE XMD05B ;filename is translate
 DEX  ;specifier to adjust for
 DEX  ;finding up/down
 LDA FBUF,X ;specifier
XMD05B STA DSKDIR
 CMP #'r' ;is direction specifer a
 BEQ XMD05C ;a valid entry?
 CMP #'w'
 BNE XMD05A
XMD05C DEX
 LDA #',' ;check for intervening comma
 CMP FBUF,X
 BEQ XMD01A
XMD05A LDA #6 ;user made an error in
 JSR OUTMSG ;filename specification
 JSR WAITTWO ;tell him and then exit
 JSR XMD19
XMD01A DEX
 PHA
 LDA FBUF,X ;now let us make sure he
 CMP #'u' ;specified a valid
 BEQ XMD01Z ;file type
 CMP #'p' ;we will accept u p or s
 BEQ XMD01Z
 CMP #'s'
 BEQ XMD01Y
 PLA
 JMP XMD05A
XMD01Y LDA #'t' ;got by syntax check
 CMP TMP2X ;now check for translate
 BNE XMD01Z ;only if a sequential
 LDA #128 ;file
 STA TRON
XMD01Z PLA
 DEX
 CMP FBUF,X
 BNE XMD05A
 LDA TEMPX ;whew! now we finally get
 LDX #<FBUF ;to open the disk file
 LDY #>FBUF
 JSR SETNAM
 LDA #8
 JSR OPENDK
 JSR ERRCHN ;error on open?
 BEQ XMD01D ;yes - exit
 JSR XMD18
XMD01D LDA #2
 JSR OUTMSG
 LDA #3
 STA CTRYS
 LDA DSKDIR
 CMP #'r' ;jump to upload or download
 BNE XMD06 ;depending on direction
 JMP XMD30 ;specified
*
* RECEIVE FILE
*
XMD06 LDA #0 ;initialize everybody
 STA FXMO
 STA XMODE
 STA LSTBLK
 STA TBCOUNT
 STA TBCOUNT+1
 STA BLKNUM
 JSR SETZERO
 JSR XMD60 ;get things rolling
 LDA #128 ;normal data block size
 STA XMOSZ
 LDA #132
 STA XBLSZ
 BIT XMODE ;checksum or crc?
 BMI XMD10 ;crc
XMD06A LDA DPORTB ;do we still have carrier?
 AND CARRIER
 BEQ XMD06A1
 JSR XMD28 ;get verification to abort
 BEQ XMD06A
XMD06A1 JSR SETZERO
XMD07 JSR GTXMDM ;go get a modem character
 LDA DPORTB ;still checking to see if
 AND CARRIER ;carrier present
 BEQ XMD07A1
 JSR XMD28
 BEQ XMD07
XMD07A1 LDA CHRCNT
 BNE XMD10
 LDA RCVCHR ;look for end of transfer as
 CMP #EOT ;first byte of block
 BNE XMD07A
 JMP XMD42
XMD07A CMP #CAN ;check for user cancel
 BNE XMD07B
 JSR XMD19
XMD07B CMP #SOH
 BNE XMD07
XMD10 JSR CHKADD ;add the data byte to checksum
 CMP XBLSZ ;is this end of this block?
 BNE XMD07 ;no - get next character
 LDA BLO ;yes - check block number
 CLC  ;with complement
 ADC BLCK1
 CLC
 CMP #255
 BEQ XMD11 ;block number is good
XMD12 JSR XMD15 ;block error - send a NAK
 JMP XMD06A
XMD11 BIT XMODE ;checksum or crc?
 BPL XMD11A ;checksum
 LDA CRC
 ORA CRC+1
 BEQ XMD11B
 BNE XMD12
XMD11A LDA CKSUM ;now see if our calculated
 SEC  ;checksum matches the one
 SBC BLCH ;we received from the sender
 CLC
 CMP BLCH
 BNE XMD12 ;checksum error - go NAK
XMD11B INC BLKNUM ;now check to see if this is
 LDA BLOCK+1 ;the block number we expected
 CMP BLKNUM
 BEQ XMD13
 DEC BLKNUM ;overlay previous 2nd buffer
 JMP XMD14C ;if sender repeated himself
XMD13 LDA FXMO ;stuff into 2nd buffer if this
 BEQ XMD14C ;is the first block
XMD14 LDY #0
 LDX #4
XMD14D LDA XMOBLK,X ;look for compuserve
 CMP CISFMT,X ;machine-specific header
 BNE XMD14B ;and strip it out
 DEX
 BPL XMD14D
 LDY #6
XMD14B STY TEMPX ;write the 2nd buffer to disk
 LDX #8
 JSR CHKOUT
XMD14A LDX TEMPX
 LDA XMOBLK,X
 BIT TRON ;translate the characters if
 BPL XMD14E ;the translate flag is on
 JSR CNVRT
XMD14E JSR CHROUT
 JSR READSS ;watch dem disk errors!
 BNE XMDERR
 INC TEMPX
 LDA XMOSZ ;is this the end of the
 CMP TEMPX ;data block portion?
 BNE XMD14A ;no - keep writing to disk
 BIT LSTBLK ;yes - is this the last
 BPL XMD14C ;block of the file?
 JMP XMD24 ;yes - time to finish up
XMD14C JSR XMDBLK ;display current block info
 LDX #0
XMD41 LDA BLDATA,X ;move 1st buffer to 2nd
 STA XMOBLK,X ;we use double-buffering for
 INX  ;on-the-fly pad stripping
 BPL XMD41 ;move 128 bytes
 STX FXMO
 LDA #ACK ;ACK the sender - this block
 JSR PTXMDM ;was good
 JSR CLRCHN
 JMP XMD06A
XMDERR JSR ERRCHN ;oops - got a disk error!
 LDA #1 ;notify the user and then
 JSR OUTMSG ;abort the file transfer
 LDA #7 ;at xmd18
 JSR OUTMSG
 LDA #13
 JSR SCNOUT
 JSR XMD18
XMD42 LDA #128 ;set last block indicator
 STA LSTBLK
 LDX #127 ;determine whether or not
 LDA XMOBLK,X ;sender used ctrl-z or null
 STA PADCHR ;as a pad character
 CMP #26
 BEQ XMD42A ;he used ctrl-z
 CMP #0
 BEQ XMD42A ;he used null
 JMP XMD42C
XMD42A LDA XMOBLK,X ;now back up into the last
 CMP PADCHR ;block until we find the
 BNE XMD42C ;final real data byte
 DEX
 BPL XMD42A
 JMP XMD24
XMD42C INX  ;set block size to match
 STX XMOSZ ;end of last block
 JMP XMD14
CNVRT AND #127 ;convert ascii-petascii
 CMP #65
 BCC XMD14L
 CMP #91
 BCS XMD14K
 ORA #32
 JMP XMD14L
XMD14K CMP #97
 BCC XMD14L
 CMP #123
 BCS XMD14L
 AND #223
XMD14L RTS
*
* GET XMODEM CHAR
*
GTXMDM JSR SETJIF ;set character timeout
GTX01 JSR STOP ;check to see if user is
 BEQ GTXEX ;pressing stop key to abort
 JSR GIM ;get character from modem
 BNE GTX02 ;was there a character?
 RTS  ;yes - return
GTX02 JSR TSTJIF ;no - did we time out yet?
 BCC GTX01 ;no - go try again
 JSR XMD16 ;yes - go to error routine
 PLA
 PLA
 JMP XMD06A ;return
GTXEX JMP XMD18 ;user wants to abort
*
* CHECK CAN,NAK APPROPRIATE
*
XMD15 INC ERR ;cancel if 10 errors in a row
 LDA #10 ;otherwise just NAK
 CMP ERR
 BEQ XMD18
*
* NAK
*
XMD16 LDA #'n'
 STA DISPR8+18
 LDA #NAK
 JSR PTXMDM
 RTS
*
* EOT
*
XMD17 LDA #EOT
 JSR PTXMDM
 RTS
*
* CAN
*
XMD18 LDA #CAN ;cancel the transfer
 JSR PTXMDM
XMD19 LDA #4 ;display message to user
 JSR XMD25
 JSR WAITTWO
 PLA  ;jump all the way back to
 PLA  ;the Basic program
 RTS
XMD28 LDA #8 ;ask user to confirm abort
 JSR XMD25
XMD28A JSR GETKEY ;get keyboard input
 PHA
 JSR CLRCHN
 PLA
 PHA
 JSR CHROUT ;display user keystroke
 PLA
 CMP #'y' ;did he confirm abort?
 BEQ XMD19 ;yes - exit transfer
 CMP #'n'
 BNE XMD28A ;not a valid response
 LDA #13
 JSR CHROUT
 LDA #0 ;set to continue on
 RTS  ;and return
*
* COMPLETE
*
XMD24 LDA #ACK ;acknowledge receipt of EOT
 JSR PTXMDM
XMD24A LDA #3 ;display completed message
XMD25 JSR OUTMSG
 LDA #8 ;close the file and go home
 JMP CLOSE
*
* SEND FILE
*
XMD30 JSR STOP ;check is using is pressing
 BNE XMD30A ;stop key
 JSR XMD19 ;yes - abort transfer
XMD30A LDA #132
 STA XBLSZ
 LDA RIDBS ;clear input buffer
 STA RIDBE
 LDA #0 ;initialize variables
 STA TBCOUNT
 STA TBCOUNT+1
 LDA #1
 STA BLN
 STA BLO
 EOR #255
 STA BLCK1
XMD30B JSR STOP ;check stop key
 BNE XMD30C
 JSR XMD17
 JSR XMD19
XMD30C JSR GIM ;get modem character
 BNE XMD30B ;no character - loop
 LDA DPORTB ;check for carrier
 AND CARRIER
 BEQ XMD30C1
 JSR XMD28 ;verify abort from user
 BEQ XMD30C
XMD30C1 LDA RCVCHR
 CMP #CAN ;is receiver cancelling?
 BNE XMD30D ;no
 JSR XMD19 ;yes - time to quit
XMD30D CMP #NAK ;was transmission bad?
 BEQ XMD31
 CMP #67
 BNE XMD30B ;no
 LDA #10
 JSR OUTMSG
 LDA #133
 STA XBLSZ
 STA XMODE
XMD31 JSR SETZERO
 LDA #3 ;retransmit last block
 STA CHRCNT ;initialize block variables
 LDX #0
 STX CKSUM
 STX RSTAT
XMD32 JSR STOP ;check stop key
 BNE XMD32A
 JMP XMD37X
XMD32A LDX #8 ;get character from disk
 JSR CHKIN
 JSR GETIN
 BIT TRON ;check for translate on
 BPL XMD32B ;no - bypass conversion
 JSR CNVRT ;yes - convert to ascii
XMD32B STA RCVCHR ;store the character
 JSR READSS ;watch dem disk errors!
 AND #195 ;look for end-of-file
 STA RSTAT ;and time-outs
 BNE XMD33A
 LDA RCVCHR ;calculate checksum with
 JSR CHKADD ;this character
 CMP #131 ;got a full block yet?
 BNE XMD32 ;no - loop
 BEQ XMD34 ;yes - process end of block
XMD33A = *
 LDA RCVCHR ;calculate checksum with
 JSR CHKADD ;this character
 CMP #131 ;is the block full?
 BEQ XMD34 ;yes - bypadd padding
 LDA #26 ;pad the final block with
 STA PADCHR ;ctrl-z unless the last
 LDA RCVCHR ;data character happens to
 CMP #26 ;be a ctrl-z
 BNE XMD33G ;if it is then use null
 LDA #0
 STA PADCHR
XMD33G LDA PADCHR ;pad out the block until
 STA RCVCHR ;we fill it up
XMD38A JSR CHKADD
 CMP #131
 BNE XMD38A
XMD34 BIT XMODE ;checksum or crc?
 BPL XMD34A ;checksum
 LDA CRC+1 ;fill in the
 STA BLCH ;16-bit crc
 LDA CRC
 STA BLCH+1
 JMP XMD34B
XMD34A LDA CKSUM ;fill in the calculated
 STA BLCH ;checksum
XMD34B LDA #0
 STA TEMPX
XMD35 JSR STOP ;check the old stop key
 BEQ XMD37X
 LDX TEMPX ;now let us output the
 LDA BLOCK,X ;entire block to the modem
 JSR PTXMDM
 LDA DPORTB ;dont forget to check for
 AND CARRIER ;carrier loss
 BEQ XMD35B
 JSR XMD28
XMD35B INC TEMPX ;did we finish the block yet?
 LDA XBLSZ
 CMP TEMPX
 BNE XMD35
 JSR SETJIF ;set the timeout
XMD36 LDA DPORTB ;being cautious we continue to
 AND CARRIER ;check for carrier
 BEQ XMD36A
 JSR XMD28
XMD36A JSR GIM ;look for the receiver response
 BEQ XMD37
 JSR STOP ;no response yet - look for the
 BEQ XMD37X ;stop key
 JSR TSTJIF ;and check for a timeout
 BCC XMD36 ;loop if not timed out yet
 BCS XMD34 ;otherwise retransmit
XMD37 LDA RCVCHR
 CMP #NAK ;did he send a NAK?
 BNE XMD37E
 LDA #'n' ;update the display and go
 STA DISPR8+18 ;back to retransmit
 JMP XMD34
XMD37E CMP #CAN ;did he send cancel?
 BNE XMD37A
XMD37X JSR XMD19 ;yes - then abort
XMD37A CMP #ACK ;did he send ACK?
 BEQ XMDACK
 CMP #67
 BNE XMD36 ;none of the above
XMDACK LDA RSTAT ;check for status not zero
 BEQ XMD38 ;no
 JSR XMD17 ;yes - send EOT
 JSR SETJIF ;set timeout
XMD37B LDA JIFFY ;check the timeout and look
 BMI XMD37C ;for final response from
 JSR GIM ;the receiver
 BNE XMD37B
XMD37C LDA RSTAT ;check for end of file
 AND #64
 BEQ XMD37X ;no - abort
 JMP XMD24A ;yes - display complete
XMD38 INC BLO ;increment the block number
 LDA #255
 EOR BLO
 STA BLCK1
 JSR XMDBLK ;display block status
 JMP XMD31 ;back for next block
*
* RECEIVE - START CRC AND SWITCH TO CHKSUM IF
*           NO RESPONSE
*
XMD60 LDA #67 ;send 'C' to indicate CRC
 JSR PTXMDM ;capability
 JSR SETJIF ;set timer for retry
XMD60A JSR GIM ;look for response
 BEQ XMD60B ;yes
 LDA JIFFY ;no - is time up?
 CMP #1
 BNE XMD60A ;no - keep looking
 DEC CTRYS ;yes - decrement trys
 BNE XMD60 ;not finished - try again
 JSR XMD16 ;switch to checksum
 RTS
XMD60B LDA RCVCHR ;get received character
 CMP #SOH ;is it start of xmodem block
 BNE XMD60A ;no - ignore it
 LDA #133 ;yes
 STA XMODE ;set CRC mode
 STA XBLSZ ;and CRC total block size
 LDA #10 ;inform the user
 JSR OUTMSG
 RTS
*
* GET XMODEM CHAR
*
GIM LDX #5
 JSR CHKIN
 JSR GETIN ;try for character
 STA RCVCHR ;and save result
 JSR READSS ;now check status
 RTS
*
* TEST JIFFY
*
TSTJIF LDA JIFFY
 CMP #2
 RTS
*
* SET JIFFY
*
SETJIF LDA #0
 STA JIFFY
 STA JIFFY+1
 RTS
*
* PUT CHAR TO MODEM
*
PTXMDM PHA
 LDX #5
 JSR CHKOUT
PTX01 LDA ENABLE ;is rs232 quiescent
 AND #3 ;in both directions
 BNE PTX01 ;no - wait until it is
 PLA  ;yes - get character
 JSR CHROUT ;and send it to modem
 RTS
*
* CALCULATE CHECKSUM
*
CHKADD LDA RCVCHR
 BIT XMODE
 BPL CHKA1
 JSR CRCMODE
CHKA1 LDA RCVCHR
 LDX CHRCNT
 STA BLOCK,X
 CLC
 ADC CKSUM
 STA CKSUM
 INC CHRCNT
 INX
 TXA
 RTS
*
* CRC MODE
*
CRCMODE STA CRCDATA
 LDX #8
 LDA CHRCNT
 CMP #3
 BGE CRCM1
 RTS
CRCM1 ASL CRCDATA
 ROR A
 AND #$80
 EOR CRC+1
 ASL CRC
 ROL A
 BCC CRCM2
 TAY
 LDA CRC
 EOR PLY
 STA CRC
 TYA
 EOR PLY+1
CRCM2 STA CRC+1
 DEX
 BNE CRCM1
 RTS
*
* CRC INIT
*
CRCINIT LDA #0
 STA CRC
 STA CRC+1
 RTS
*
* OUTMSG PROMPT POINTER TABLE
*
PRMTBL = *
 DA PROMPT4
 DA PRMPT13
 DA DISPR8
 DA DISPR9
 DA DISPR10
 DA DISPR11
 DA DISPR13
 DA BUF
 DA PRMPT10
 DA PRMPT11
*
* PROMPTS
*
PROMPT4 DFB 13
 TXT 'Filename for your disk: '
 DFB 0
PRMPT13 DFB 13
 TXT 'DISK ERROR: '
 DFB 0
DISPR8 TXT 'TOT BLK 0000  CHK= '
 DFB 13,145,0
DISPR9 TXT 'TRANSFER COMPLETE'
 DFB 13,0
DISPR10 TXT 'TRANSFER ABORTED'
 DFB 13,0
DISPR11 TXT 'XMODEM PROTOCOL'
 DFB 13,0
DISPR13 TXT 'Invalid Filename'
 DFB 13,0
PRMPT10 TXT 'CARRIOR LOST: CONFIRM ABORT y/n  '
 DFB 0
PRMPT11 TXT 'using CRC'
 DFB 13,0
*
* OUTPUT MESSAGE TO DEVICE
*
OUTMSG PHA
 LDX #3
 JSR CHKOUT
 PLA
 ASL A
 TAX
 LDA PRMTBL,X
 STA MOVE
 INX
 LDA PRMTBL,X
 STA MOVE+1
 LDY #0
OUTLP1 LDA (MOVE),Y
 CMP #0
 BEQ OUTEND
 JSR CHROUT
 INY
 CPY #0
 BNE OUTLP1
OUTEND RTS
*
* CHECK ERROR CHANNEL
*
ERRCHN LDA #0
 STA BUF
 STA EBUFX
 LDX #15
 JSR CHKIN
ERRL1 JSR GETIN
 STA RCVCHR
 JSR READSS
 BNE ERRL2
 LDA RCVCHR
 LDX EBUFX
 STA BUF,X
 INC EBUFX
 BNE ERRL1
ERRL2 LDX EBUFX
 LDA #0
 STA BUF,X
 LDA #7
 JSR OUTMSG
 JSR WAITTWO
 LDA BUF
 ORA BUF+1
 AND #15
 RTS
*
* DECIMAL CONVERSION TABLE
*
DECTAB DFB 16,39 ; 10,000
 DFB 242,3 ; 1,000
 DFB 100,0 ; 100
 DFB 10,0 ; 10
 DFB 1,0 ; 1
COUNT DFB 0,0
NUMBR DFB 0,0,0,0,0,32,32,0
TMPCNT DFB 0,0
*
* OPEN DISK FILE A=LOGICAL FILE
*
OPENDK = *
 TAY
 LDX DRVDEV
 JSR SETLFS
 JSR OPEN
 RTS
*
* CONVERT TO ASCII
*
CNVASC LDX #4
 LDA #48
CNVA4 STA NUMBR,X
 DEX
 BPL CNVA4
 INX
CNVA1 LDA COUNT
 SEC
 SBC DECTAB,X
 STA TMPCNT
 LDA COUNT+1
 SBC DECTAB+1,X
 STA TMPCNT+1
 BCC CNVA2
 STX TEMPX
 TXA
 LSR A
 TAX
 INC NUMBR,X
 LDX TEMPX
 LDA TMPCNT
 STA COUNT
 LDA TMPCNT+1
 STA COUNT+1
 JMP CNVA1
CNVA2 INX
 INX
 CPX #10
 BNE CNVA1
 LDX #4
 RTS
*
* DISPLAY XMODEM BLOCK
*
XMDBLK LDA #'a'
 STA DISPR8+18
 INC TBCOUNT
 BNE XBLK2
 INC TBCOUNT+1
XBLK2 LDA TBCOUNT
 STA COUNT
 LDA TBCOUNT+1
 STA COUNT+1
 JSR CNVASC
 LDX #4
XBLK1 LDA NUMBR,X
 STA DISPR8+7,X
 DEX
 BNE XBLK1
 LDA #2
 JSR OUTMSG
 RTS
*
* WAIT TWO SECONDS
*
WAITTWO JSR SETJIF
WAIT2 BIT JIFFY+1
 BPL WAIT2
 RTS
*
* GET A KEYBOARD CHARACTER
*
GETKEY LDX #0
 JSR CHKIN
 JSR GETIN
 BEQ GETKEY
 RTS
*
* INITIALIZE BLOCK VARIABLES
*
SETZERO LDA #0
 STA ERR
 STA CHRCNT
 STA CKSUM
 JSR CRCINIT ;XMODEM CRC
 RTS
*
* OUTPUT TO SCREEN
*
SCNOUT PHA
 LDX #3
 JSR CHKOUT
 PLA
 JSR CHROUT
 RTS